home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Tools / Mac F2C 1.3.3 / Test Project ƒ / test.f < prev    next >
Text File  |  1996-06-24  |  6KB  |  219 lines
  1.     Program test_f2c
  2.     
  3. c    This is a FORTRAN program to test Mac F2C v1.1
  4.  
  5.     character    junk*2
  6.  
  7.     write(6,*) '*****   Input/Output Test   *****'
  8.     call i_o_test
  9.     write(6,*) '\n*****   End of I/O test, hit return to continue...'
  10.     read(5,99) junk
  11. 99    format( a1 )
  12.  
  13.     write(6,*) '\n*****   Integer Math Test   *****'    
  14.     call int_test( 10 )
  15.     write(6,*) '\n*****   End of integer math test, hit return to continue...'
  16.     read(5,99) junk
  17.  
  18.     write(6,*) '\n*****   Floating Point Math Test   *****'
  19.     call flt_test( 10 )
  20.     write(6,*) '\n*****   End of floating point math test, hit return to continue...'
  21.     read(5,99) junk
  22.  
  23.     write(6,*) '\n*****   Algebraic Function Test   *****'
  24.     call alg_test( 10 )
  25.     write(6,*) '\n*****   End of algebraic function test, hit return to continue...'
  26.     read(5,99) junk
  27.  
  28.     write(6,*) '\n*****   Transcendental Function Test   *****'
  29.     call trn_test
  30.     write(6,*) '\n*****   End of transcendental function test, hit return to continue...'
  31.     read(5,99) junk
  32.     
  33.     write(6,*) '\n*****   This completes all of the tests   *****'
  34.     
  35.     stop
  36.     end
  37.     
  38.     
  39.  
  40. c************************************************************************
  41. c
  42. c    Subroutine to do the I/O tests
  43. c
  44. c************************************************************************
  45.     
  46.     subroutine  i_o_test
  47.     dimension a(5), j(5)
  48.     double precision  dx
  49.     character text*40
  50.     
  51. c     Screen I/O tests
  52.  
  53.     write(6,*) '\nPart 1:  Screen I/O tests.\n\nEnter an integer value.'
  54.     read(5,*) i
  55.     write(6,*) 'The number you entered was:', i
  56.  
  57.     write(6,*) '\nEnter a single precision floating point value...'
  58.     read(5,*) x
  59.     write(6,312) x
  60. 312    format(1x, 'The number you entered was: ', f13.6)
  61.  
  62.     write(6,*) '\nEnter a double precision floating point value...'
  63.     read(5,*) dx
  64.     write(6,313) dx
  65. 313    format(1x, 'The number you entered was: ', f17.10)
  66.  
  67.     write(6,*) '\nEnter some text (40 char max)...'
  68.     read(5,*) text
  69.     write(6,*) 'The text you entered was: ', text
  70.     
  71.     write(6,*) '\nPart 2:  file I/O tests.  Hit return to continue...'
  72.     read(5,399) text
  73. 399    format( a1 )
  74.     
  75. c     File I/O tests:  Store some values and write them to file
  76.  
  77.     do i = 1,5
  78.       j(i) = i
  79.       a(i) = dble(i)
  80.     enddo
  81.     text = 'A test message.'
  82.     open(60,file='test.dat',form='unformatted')
  83.     write(60) text, j, a
  84.     close(60)
  85.     
  86.     write(6,*) 'Wrote the following data to file test.dat:\n'
  87.     write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
  88. 304    format( 5x, a20, 5(i1, 2x), 5x, 5(f4.2, 2x) )
  89.  
  90. c Reset the variables and read them back
  91.  
  92.     do i = 1,5
  93.       j(i) = 99
  94.       a(i) = 99
  95.     enddo
  96.     text = 'reset'
  97.     open(50,file='test.dat',form='unformatted')
  98.     read(50) text, j, a
  99.     close(50)
  100.     
  101.     write(6, *) '\nRead the following data from file test.dat:\n' 
  102.     write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
  103.  
  104.     return
  105.     end
  106.     
  107.     
  108.     
  109.     
  110. c************************************************************************
  111. c
  112. c    Subroutine to do the integer math tests
  113. c
  114. c************************************************************************
  115.  
  116.     subroutine  int_test( m )
  117.     write( 6, *) '\nGenerate a table of integers, squares, cubes, and their halves.\n'
  118.     write(6, 203)
  119. 203    format( 10x, 'n', 5x, 'n^2', 5x, 'n^3', 5x, 'n/2', 3x, 'n^2/2', 3x, 'n^3/2' )
  120.     do i = 1, m
  121.         j = i**2
  122.         k = i**3
  123.         write( 6, 202 )  i, j, k, i/2, j/2, k/2
  124. 202        format( 5x, 6( i6, 2x ) )
  125.     end do
  126.     return
  127.     end
  128.  
  129.  
  130.  
  131. c************************************************************************
  132. c
  133. c    Subroutine to do the floating point math tests
  134. c
  135. c************************************************************************
  136.  
  137.     subroutine  flt_test( m )
  138.     write( 6, * ) '\nGenerate a table of floats, their squares, cubes, and their halves.\n'
  139.     write(6, 205)
  140. 205    format( 12x, 'x', 6x, 'x^2', 6x, 'x^3', 6x, 'x/2', 4x, 'x^2/2', 4x, 'x^3/2' )
  141.     do i = 1, m
  142.         x1 = i*1.0
  143.         x2 = x1**2
  144.         x3 = x1**3
  145.         write( 6, 201 )  x1, x2, x3, x1/2, x2/2, x3/2
  146. 201        format( 5x, 6( f8.2, 1x ) )
  147.     end do
  148.     return
  149.     end
  150.  
  151.  
  152.  
  153.  
  154. c************************************************************************
  155. c
  156. c    Subroutine to do the algebraic function tests
  157. c
  158. c************************************************************************
  159.  
  160.     subroutine  alg_test( m )
  161.     write( 6, * ) '\nGenerate a table of floats, square & cube roots, and their squares & cubes.\n'
  162.     write(6, 305)
  163. 305    format( 10x, 'x', 7x, 'SQRT(x)', 4x, 'CURT(x)', 3x, 'SQRT(x)^2', 2x, 'CURT(x)^3' )
  164.     do i = 1, m
  165.         x1 = i*1.0
  166.         x2 = sqrt(x1)
  167.         x3 = x1**(1.0/3.0)
  168.         write( 6, 301 )  x1, x2, x3, x2**2, x3**3
  169. 301        format( 5x, 6( f9.6, 2x ) )
  170.     end do
  171.     return
  172.     end
  173.  
  174.  
  175.  
  176.  
  177. c************************************************************************
  178. c
  179. c    Subroutine to do the transcendental function tests
  180. c
  181. c************************************************************************
  182.  
  183.     subroutine  trn_test
  184.     double precision  pi, x, s, c, s2, c2
  185.     character junk*2
  186.     
  187.     pi = 3.141592653589793
  188.     write( 6, * ) '\nPart 1: Trig Functions'
  189.     write( 6, *) '\nGenerate a table of x, sin(x), cos(x) and the sum of their squares.\n'
  190.     write(6, 207)
  191. 207    format( 9x, 'x', 9x, 'sin(x)', 8x, 'cos(x)', 4x, 'sin(x)^2 + cos(x)^2' )
  192.     do i = 0, 12
  193.         x = i * pi / 6.0
  194.         s = dsin( x )
  195.         c = dcos( x )
  196.         s2 = s**2
  197.         c2 = c**2
  198.         write( 6, 200) i, s, c, s2 + c2
  199. 200        format( 5x, i2,'*pi/6' 3x, f11.8, 3x, f11.8, 3x, f15.10 )
  200.     end do
  201.  
  202.     write(6,*) '\nPart 2:  Exponential functions; hit return to continue...'
  203.     read(5,299) junk
  204. 299    format( a1 )
  205.  
  206.     write(6,*) 'Generate a table of x, log(x), and exp(log(x))\n'
  207.     write(6, 208)
  208. 208    format( 11x, 'x', 16x, 'log(x)', 9x, 'exp(log(x))' )
  209.     do i = 1, 10
  210.         x = dble(i)
  211.         s = dlog(x)
  212.         c = dexp(s)
  213.         write(6, 201) x, s, c
  214. 201        format( 5x, f13.10, 5x, f13.10, 5x, f13.10 )
  215.     end do
  216.     
  217.     return
  218.     end
  219.